home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Input 64
/
Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64
/
sets .lsp
< prev
next >
Wrap
Text File
|
2023-02-26
|
2KB
|
55 lines
(setfns value (setfns mem1 subset
symm-diff union intersection makeset
seteq setp subsetp enter attach
insert dremove))
(mem1 expr (lambda (l1 l2) (cond ((
atom l1) nil) ((member (car l1) l2)) (
t (mem1 (cdr l1) l2)))))
(subset expr (lambda (fun l) (cond ((
atom l) nil) ((apply* fun (car l)) (
cons (car l) (subset fun (cdr l)))) (
t (subset fun (cdr l))))))
(symm-diff expr (lambda (l1 l2) (cond
((atom l1) nil) ((member (car l1) l2)
(symm-diff (cdr l1) l2)) (t (cons (
car l1) (symm-diff (cdr l1) l2))))))
(union expr (lambda (l1 l2) (cond ((
atom l1) l2) ((member (car l1) l2) (
union (cdr l1) l2)) (t (cons (car l1)
(union (cdr l1) l2))))))
(intersection expr (lambda (l1 l2) (
cond ((atom l1) nil) ((member (car l1)
l2) (cons (car l1) (intersection (
cdr l1) l2))) (t (intersection (cdr
l1) l2)))))
(makeset expr (lambda (l1) (cond ((
atom l1) nil) ((not (member (car l1) (
cdr l1))) (cons (car l1) (makeset (
cdr l1)))) (t (makeset (cdr l1))))))
(seteq expr (lambda (l1 l2) (cond ((
equal l1 l2)) ((atom l1) (atom l2)) ((
member (car l1) l2) (seteq (cdr l1) (
remove (car l1) l2))))))
(setp expr (lambda (l1) (cond ((null
l1) t) ((member (car l1) (cdr l1))
nil) (t (setp (cdr l1))))))
(subsetp expr (lambda (l1 l2) (cond ((
equal l1 l2)) ((atom l1)) ((member (
car l1) l2) (subsetp (cdr l1) l2)))))
(enter expr (lambda (x l) (cond ((
member x l) l) (t (attach x l)))))
(attach expr (lambda (x l) (cond ((
atom l) (cons x nil)) (t (rplacd l (
cons (car l) (cdr l))) (rplaca l x))))
)
(insert expr (lambda (x y l) (attach
x (nth l y)) l))
(dremove expr (lambda (l1 l2) (prog (
l3 l4) (setq l4 l2) loop (cond ((atom
l4) (return l2)) ((setq l3 (member l1
l4)) (cond ((atom (cdr l3)) (return
l2)) (t (rplaca l3 (cadr l3)) (rplacd
l3 (cddr l3))))) (t (setq l4 (cdr l4))
)) (go loop))))
nil